perm filename TOP2[AM,DBL] blob
sn#159845 filedate 1975-05-22 generic text, type T, neo UTF8
(FILECREATED "22-MAY-75 19:48:41" TOP2.;15 24923
changes to: CLOSESTUP ALL-OF AVG2 GLOB IS-ONE-OF ONE-ISA
previous date: "19-MAY-75 21:19:30" TOP2.;14)
(LISPXPRINT (QUOTE TOP2COMS)
T T)
[RPAQQ TOP2COMS
((FNS ACCEPT-B ACCESS ADD-CANDS ALL-OF ALL-UP AM-BT AVG2 CHANGE-B CHECK CLASS CLOSESTUP CMATCH CMATCH-AND
COM-ANCES COMMENT CREATEB DE-THRESH DOTPROD ED-1F ED-1P ED-1V ED-ALL ED-ALLF ED-ALLP ED-ALLV ENSURE
ENSURE-TOP EXPR-IN FILLIN FIND-NEW-CANDS FORGOT-ANY GATH GEN-FNAME GEXADD GEXEC GLOB GPGM-PRIN GTRANSFER
IN-FACTOR INIT-C INIT-PART INIT1 INIT2 INSTAN-1D INSTAN-1I INSTAN-1S INSTAN-BASE INSTAN-D INSTAN-I
INSTAN-PAT INSTAN-REC INSTAN-S IS-ONE-OF ISA KINDS-OF LESS-INT LISTFILES1 MCON MORE-GENERAL MORE-INT
MORE-SPECIFIC MTOP NEW-VERSION NFN NFUN ONE-ISA PRUNABLE PRUNE RAND-PRED RECTANGLE RE-JUDGE SAME-TYPE
SATISFIES SELF SFIND S-MATCH START SWITCH SUB-CANDS TLOOP TRIV-DEFINE UNFORGETTABLE UP-THRESH UPDATE)
CAND-TAIL CANDS CONSTRUCTIVE-OPS DO-THRESH EX-THRESH F-COUNTER FROB FROB1 FROB2 GLOBALVARS INIT-CANDS
INIT-PAST INIT-DOTHRESH INIT-EXTHRESH INIT-INTHRESH INTHRESH PAST RANDSTATE STICKY-B STICKY-P SYS-FORGET-LIST
TOP-ACTS TRIVB USERNAMES VERBOSITY VERSION (P (INIT1))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA S-MATCH COMMENT CMATCH CLASS)
(NLAML SWITCH SELF RE-JUDGE MTOP MCON
CMATCH-AND]
(DEFINEQ
(ACCEPT-B
[LAMBDA (B SIM)
(SETQ CONCEPTS (CONS B CONCEPTS))
(TERPRI)
[COND
((MEMB SIM CONCEPTS))
((PRIN1 "NAME OF SIMILAR BEING... ")
(SETQ SIM (RATOM]
(TERPRI)
(PUTD B (COPY (EXPR-IN SIM T)))
(ERRORSET (LIST (QUOTE EDITF)
B
(LIST (QUOTE RC)
SIM B)))
(EVAL (LIST (QUOTE EDITF)
B -1 (QUOTE P)
(QUOTE TTY:)))
(SETQ LAPFLG)
(SETQ SVFLG (SETQ STRF T))
(TERPRI)
(COMPILE1 B (GETD B))
(PRIN1 "THE NUMBER OF CONCEPTS IS NOW ")
(PRINT (LENGTH CONCEPTS))
B])
(ACCESS
[LAMBDA (A)
A])
(ADD-CANDS
[LAMBDA (C C1)
(SETQ C1 (SOME C (QUOTE PRUNABLE)))
(COND
(C1 (FRPLACD C1 NIL)))
(MERGE C CANDS (QUOTE MORE-INT))
(SETQ NEW-CANDS (IGREATERP (CAAR CANDS)
DO-THRESH])
(ALL-OF
[LAMBDA (ATYPE)
(PROG ((ALL-LIST (LIST ATYPE))
(ALL-LEN 1))
L1 (SETQ ALL-LIST (UNION [MAPCONC ALL-LIST (FUNCTION (LAMBDA (AL1)
(CAR (ERSETQ (APPLY* AL1 (QUOTE DOWN]
ALL-LIST))
(COND
((EQ ALL-LEN (SETQ ALL-LEN (LENGTH ALL-LIST)))
(RETURN ALL-LIST)))
(GO L1])
(ALL-UP
[LAMBDA (AB)
(COND
(AB (CONS AB (ALL-UP (APPLY* AB (QUOTE UP])
(AM-BT
[LAMBDA (V1)
(MAPDL (FUNCTION (LAMBDA (DX)
(COND
((OR (MEMB DX (CAR TOP2COMS))
(MEMB DX CONCEPTS))
(PRIN1 DX)
(COND
((SETQ V1 (VARIABLES MAPDLPOS))
(TERPRI)
(PRIN1 " ")
(PRINT V1)
(PRIN1 " ")
(PRINT (STKARGS MAPDLPOS)))
((PRIN1 " ---NO ARGS")
(TERPRI])
(AVG2
[LAMBDA (N1 N2)
(IQUOTIENT (IPLUS N1 N2)
2])
(CHANGE-B
[LAMBDA (B P CP)
[COND
((MEMB B FACETS)
(SETQ P B)
(PRINT (SETQ B STICKY-B)))
[(MEMB B CONCEPTS)
(COND
((MEMB P FACETS))
((PRINT (SETQ P STICKY-P]
(B (TERPRI)
(PRIN1 "***** CANT UNDERSTAND THIS *****")
(HELP))
(T (PRINT (SETQ B STICKY-B))
(PRINT (SETQ P STICKY-P]
(SETQ STICKY-B B)
(SETQ STICKY-P P)
[COND
[(ERRORSET (LIST (QUOTE EDITF)
B
(QUOTE F)
P
(QUOTE P)
(QUOTE TTY:]
(T (TERPRI)
(PRIN1 "THAT PART IS NOT IN THAT CONCEPT YET")
(TERPRI)
(ERRORSET (LIST (QUOTE EDITF)
B -1 (LIST -3 (LIST P (QUOTE FILL-THIS-IN)))
3
(QUOTE P)
(QUOTE TTY:]
(SETQ CP (PACK (LIST (QUOTE C-)
P)))
[COND
((MEMB CP FACETS)
(TERPRI)
(PRIN1 "COMPILE THIS??? (Y OR N)... ")
(COND
((EQ (RATOM)
(QUOTE Y)) (* ADD A COPY WITHOUT QUOTES)
(ERRORSET (LIST (QUOTE EDITF)
B
(QUOTE F)
P
(QUOTE UP)
(LIST (QUOTE INSERT)
(LIST (QUOTE ##)
1)
(QUOTE BEFORE)
1)
1
(LIST 1 CP)
(LIST (QUOTE BO)
2)
(LIST 2)
0
(QUOTE P))
T))
(T (* JUST ADD CP TO P KEY OF SELECTQ)
(ERRORSET (LIST (QUOTE EDITF)
B
(QUOTE F)
P
(LIST 1 (LIST CP P))
(QUOTE P]
(TERPRI)
(PRIN1 B)
(PRIN1 (QUOTE ,))
(PRINT P])
(CHECK
[LAMBDA (XVAL CHECK-TYPE)
(AND XVAL (SETQ GEXISTING (CADR (SFIND (EXPR-IN CS-B)
CS-P)))
(PROG1 (SETQ GATH-PART CS-P)
(SETQ GPGM (LIST T))
(GATH CS-B)
(GPGM-PRIN (QUOTE GEXEC)
(QUOTE C-CHECK])
(CLASS
[NLAMBDA X
(CONS (QUOTE CLASS)
X])
(CLOSESTUP
[LAMBDA (B4 P4 CLTEMP)
(COND
((GETHASH (SETQ CLTEMP (PACK (LIST B4 (QUOTE -)
P4)))
HCON)
CLTEMP)
((GETHASH B4 HCON)
(CLOSESTUP (APPLY* B4 (QUOTE UP))
P4))
(T (QUOTE ANYB-ANYP])
(CMATCH
[NLAMBDA ZZ NIL])
(CMATCH-AND
[NLAMBDA (A1 A2 V1)
NIL])
(COM-ANCES
[LAMBDA (B1 B2 ANLIST)
[MAP2C (DREVERSE (ALL-UP B1))
(DREVERSE (ALL-UP B2))
(FUNCTION (LAMBDA (AN1 AN2)
(AND (EQ AN1 AN2)
(SETQ ANLIST (CONS AN1 ANLIST]
ANLIST])
(COMMENT
[NLAMBDA X
(CONS (QUOTE COMMENT)
X])
(CREATEB
[LAMBDA (B P)
(PRIN1 " CREATION FUNCTION ISNT IN YET. GOOD LUCK!!! ")
(PRIN1 B)
(PRIN1 ", ")
(PRINT P)
(SETQ CONCEPTS (CONS B CONCEPTS))
(* Perhaps we need something like (PUTD B (COPY (EXPR-IN GSIM)))
(ERRORSET (LIST (QUOTE EDITF) B (LIST (QUOTE RC) GSIM B))), if we can FIND some similar being gsim)
(PUTD B (LIST (QUOTE LAMBDA)
(LIST (QUOTE P))
(LIST (QUOTE SELECTQ)
(QUOTE P)
(LIST P (LIST (QUOTE CLASS)))
(LIST (QUOTE AND)
(LIST (QUOTE SETQ)
(QUOTE GTEMP)
(LIST (QUOTE GETHASH)
(QUOTE P)
(QUOTE PREC)))
(LIST (QUOTE CDR)
(LIST (QUOTE SFIND)
(LIST (QUOTE EXPR-IN)
(LIST (QUOTE QUOTE)
B))
(QUOTE P])
(DE-THRESH
[LAMBDA NIL
(SETQ DO-THRESH (IQUOTIENT (ITIMES DO-THRESH 2)
3))
(COND
((IGREATERP VERBOSITY 7)
(PRIN1 " DO-THRESH REDUCED TO ")
(PRINT DO-THRESH])
(DOTPROD
[LAMBDA (V1 V2)
(COND
(V1 (COND
[V2 (PLUS (TIMES (CAR V1)
(CAR V2))
(DOTPROD (CDR V1)
(CDR V2]
(0)))
(0])
(ED-1F
[LAMBDA (F1)
(AND (EXPR-IN F1 T)
(ERRORSET (CONS (QUOTE EDITF)
(CONS F1 ECMS)))
(PRIN1 F1)
(PRIN1 " ")
(EXPR-IN F1])
(ED-1P
[LAMBDA (P1)
(AND (CDR P1)
(ERRORSET (CONS (QUOTE EDITP)
(CONS P1 ECMS)))
(PRIN1 P1)
(PRIN1 " "])
(ED-1V
[LAMBDA (V1)
(AND (LITATOM V1)
(LISTP (CAR (ERRORSET V1)))
(ERRORSET (CONS (QUOTE EDITV)
(CONS V1 ECMS)))
(PRIN1 V1)
(PRIN1 " "])
(ED-ALL
[LAMBDA (EECMS)
(SETQ ECMS EECMS)
(ED-ALLF)
(ED-ALLV)
(ED-ALLP])
(ED-ALLF
[LAMBDA NIL
(MAPC (CDAR TOP2COMS)
(QUOTE ED-1F))
(MAPC CONCEPTS (QUOTE ED-1F])
(ED-ALLP
[LAMBDA NIL
(MAPC CONCEPTS (QUOTE ED-1P])
(ED-ALLV
[LAMBDA NIL
(MAPC TOP2COMS (QUOTE ED-1V))
(MAPC CON2COMS (QUOTE ED-1V])
(ENSURE
[LAMBDA (B P)
(OR (AND (MEMB P FACETS)
(OR (MEMB B CONCEPTS)
(CREATEB B P))
(OR (SFIND (EXPR-IN B T)
P)
(SFIND (GETP B (QUOTE EXPR))
(GETHASH P PREC))
(INIT-PART B P)))
(AND (PRIN1 "**WARNING: B,P NOT ACCESSABLE: ")
(PRIN1 B)
(PRIN1 ", ")
(PRINT P)
(TERPRI])
(ENSURE-TOP
[LAMBDA NIL
(OR (AND (MEMB CS-P FACETS)
(OR (MEMB CS-B CONCEPTS)
(CREATEB CS-B CS-P))
(MEMB CS-OP TOP-ACTS))
(AND (PRIN1 "***WARNING: CS ACT,B,P AREN'T MEANINGFUL (YET): ")
(PRIN1 CS-OP)
(PRIN1 ", ")
(PRIN1 CS-B)
(PRIN1 ", ")
(PRINT CS-P)
NIL])
(EXPR-IN
[LAMBDA (B E-FLAG)
(COND
[(AND E-FLAG (GETP B (QUOTE EXPR]
(T [COND
((GETP B (QUOTE EXPR)))
[(PUT B (QUOTE EXPR)
(LISTP (GETD B]
[(ERSETQ (LOADFNS B (GETP B (QUOTE FROM-FILE))
(QUOTE PROP]
(T (TERPRI)
(PRIN1 "***** WARNING: ")
(PRIN1 B)
(PRIN1 " IS NOT FINDABLE. DEFINING IT AS: ")
(TERPRI)
(PRINT (PUT B (QUOTE EXPR)
TRIVB]
(COND
(E-FLAG (GETP B (QUOTE EXPR)))
((PUTD B (GETP B (QUOTE EXPR])
(FILLIN
[LAMBDA (XVAL FILL-TYPE ORIG-EMP)
(EXPR-IN CS-B)
(SETQ GATH-PART CS-P)
(COND
[(SETQ GEXISTING (CADR (SFIND (GET CS-B (QUOTE EXPR]
((SETQ ORIG-EMP T)
(INIT-PART CS-B CS-P)))
(SETQ GPGM (LIST T))
(SETQ GEXISTING (NCONC1 GEXISTING (QUOTE FILLIN-MARKER)))
(GATH CS-B) (* Gpgm now contains a list of
(b,p) pairs to ACCESS to fill in CS-P
part of CS-B being)
(GPGM-PRIN (QUOTE GEXADD)
(QUOTE C-FILLIN))
(SETQ GEXISTING (DREMOVE (QUOTE FILLIN-MARKER)
GEXISTING])
(FIND-NEW-CANDS
[LAMBDA NIL
(COND
((IGREATERP VERBOSITY 6)
(PRIN1 " MUST FIND NEW CANDS. ")
(TERPRI)))
(SETQ NEW-CANDS T)
(SETQ INTHRESH (IN-FACTOR DO-THRESH))
[ADD-CANDS (COND
((SORT (MAPCONC CONCEPTS (QUOTE UNFORGETTABLE))
(QUOTE MORE-INT)))
((SETQ NEW-CANDS]
(COND
(NEW-CANDS)
(T (DE-THRESH)
(COND
((IGREATERP VERBOSITY 3)
(PRIN1 "
THERE WERE NO INTERESTING ACTIVITIES FOUND ON A SWEEP. ")
(TERPRI)))
(COND
((ILESSP (CAAR CANDS)
DO-THRESH)
(FIND-NEW-CANDS])
(FORGOT-ANY
[LAMBDA (FF)
(TERPRI)
(PRIN1 "MAYBE YOU FORGOT SOME OF THESE: ")
[MAPATOMS (FUNCTION (LAMBDA (X)
(AND (EXPRP X)
(NOT (MEMB X (CAR TOP2COMS)))
(NOT (MEMB X CONCEPTS))
(NOT (MEMB X SYS-FORGET-LIST))
(NOT (MEMB X FACETS))
(NOT (MEMB X STRAT))
(PRIN1 X)
(PRIN1 (QUOTE % % ))
(SETQ FF T]
(COND
(FF (TERPRI)
(PRINT (QUOTE THINK!!!)))
(T (PRIN1 " NEVER MIND. ")))
(TERPRI])
(GATH
[LAMBDA (B GENB GENP)
(COND
((SETQ GENB (APPLY* B (QUOTE UP)
(QUOTE FILLIN)))
(COND
((GETHASH (SETQ GENP (PACK (LIST GENB (QUOTE -)
GATH-PART)))
HCON)
(ATTACH GENP GPGM)))
(COND
((GETHASH [SETQ GENP (PACK (LIST GENB (QUOTE -ANYP]
HCON)
(ATTACH GENP GPGM)))
(GATH GENB])
(GEN-FNAME
[LAMBDA (A B)
(PACK (LIST (QUOTE F)
A
(QUOTE -)
B
(QUOTE -)
(SETQ F-COUNTER (ADD1 F-COUNTER])
(GEXADD
[LAMBDA (GB)
(NCONC GEXISTING (APPLY* GB GPNAME])
(GEXEC
[LAMBDA (GB)
(APPLY* GB GPNAME])
(GLOB
[LAMBDA (GV)
[COND
((AND GV (NLISTP GV))
(SETQ GV (LIST GV]
(MERGE (SORT GV)
GLOBALVARS)
(SETQ GLOBALVARS (INTERSECTION GLOBALVARS GLOBALVARS))
(PRIN1 " THE NUMBER OF GLOBAL VARAIABLES IS NOW ")
(PRINT (LENGTH GLOBALVARS])
(GPGM-PRIN
[LAMBDA (GFN GNAM)
(COND
[(CDR GPGM)
(DREMOVE T GPGM)
(COND
((IGREATERP VERBOSITY 9)
(PRIN1 " THE GPGM TO ")
(PRINT GNAM)
(PRIN1 CS-B)
(PRIN1 ",")
(PRIN1 CS-P)
(PRINT " IS:")
(PRINT GPGM)))
(SETQ GPNAME (GETHASH GNAM SUF1))
(MAPC GPGM GFN)
(SETQ GPNAME (GETHASH GNAM SUF2))
(MAPC (DREVERSE GPGM)
GFN)
(ADD-CANDS (LIST (LIST 400 (QUOTE RE-JUDGE)
(LIST CS-B CS-P]
(T (COND
((GREATERP VERBOSITY 3)
(TERPRI)
(PRIN1 "****WARNING: UNABLE TO FIND ANY RELE INFO TO ")
(PRIN1 GNAM)
(PRIN1 " THE ")
(PRIN1 CS-P)
(PRIN1 " PART OF ")
(PRINT CS-B])
(GTRANSFER
[LAMBDA (GEX NEWGP)
(DREMOVE GEX GEXISTING)
(NCONC1 (ENSURE CS-B (PACK (LIST CS-P NEWGP)))
GEX])
(IN-FACTOR
[LAMBDA (N)
(IQUOTIENT N 5])
(INIT-C
[LAMBDA NIL
(SETQ HCON (HARRAY 503))
(MOVD (QUOTE OR)
(QUOTE ANY-OF)
T)
[MAPC CONCEPTS (FUNCTION (LAMBDA (C)
(PUTHASH C 1 HCON]
(PRIN1 "THE NUMBER OF CONCEPTS IS ")
(PRINT (LENGTH CONCEPTS))
(SETQ SUF1 (HARRAY 100))
(SETQ SUF2 (HARRAY 100))
(SETQ PREC (HARRAY 64))
[SETQ UCASELST (APPEND (SUBSET TOP2COMS (QUOTE ATOM))
(SUBSET CON2COMS (QUOTE ATOM]
(MAPC STRAT (QUOTE TRIV-DEFINE))
(MAPC FACETS (FUNCTION (LAMBDA (FACET)
(SET FACET FACET)
(PUTHASH FACET (PACK (NCONC1 (UNPACK FACET)
1))
SUF1)
(PUTHASH FACET (PACK (NCONC1 (UNPACK FACET)
2))
SUF2)
(SETQ GTEMP (PACK (LIST (QUOTE C-)
FACET)))
(COND
((MEMB GTEMP FACETS)
(PUTHASH FACET GTEMP PREC)))
(TRIV-DEFINE FACET])
(INIT-PART
[LAMBDA (B P)
(CAR (ATTACH [LIST P (SETQ GEXISTING (COND
[(CAR (ERSETQ (APPLY* (PACK (LIST (QUOTE ANYB-)
P))
(QUOTE REPR)
(QUOTE INIT]
((LIST (QUOTE ANY-OF]
(CDDR (CADDR (EXPR-IN B])
(INIT1
[LAMBDA NIL
(CLDISABLE (QUOTE -))
(WIDEPAPER T)
(RAISE)
[INTERRUPTCHAR 24 (QUOTE (PROGN (TERPRI)
(PRIN1 " *** BACKTRACING:")
(TERPRI)
(AM-BT)
(TERPRI)
(PRIN1 "*** END OF BACKTRACE")
(TERPRI]
[INTERRUPTCHAR 25 (QUOTE (PROGN (TERPRI)
(PRIN1 " *** NUMBER OF CANDS IS ")
(PRINT (LENGTH CANDS]
[INTERRUPTCHAR 26 (QUOTE (PROGN (TERPRI)
(PRIN1 " *** INTEREST ")
(PRIN1 DO-THRESH)
(PRIN1 ", ")
(PRIN1 INTHRESH)
(PRIN1 ", NCANDS=")
(PRIN1 (LENGTH CANDS))
(PRIN1 ", CAND=")
(PRINT CAND]
(TERPRI)
(PRIN1 "YOU PROBABLY WANT TO LOAD IN THE FILE CON2 NOW")
(RANDSET RANDSTATE)
(TERPRI])
(INIT2
[LAMBDA NIL
(SETQ DFNFLG T)
(SETQ LISPXHISTORY)
(SETQ EDITHISTORY])
(INSTAN-1D
[LAMBDA (D BASE REC PAT P)
(SELECTQ (SETQ P (EVAL (CADR D)))
[RECURSIVE (COND
((AND (MATCH (CADDR D) WITH ((QUOTE OR)
BASE←&
REC←&))
(NCONC (INSTAN-BASE BASE)
(INSTAN-REC REC]
[NON-RECURSIVE (COND
((AND (MATCH (CADDR D) WITH ((QUOTE MATCH)
(QUOTE A)
(QUOTE WITH)
PAT←&))
(LIST (INSTAN-PAT PAT]
(IMPLICIT NIL)
(PROGN (TERPRI)
(PRIN1 "******* WARNING: NOT A KNOWN TYPE OF DEFN: ")
(PRINT D)
(PRIN1 " EVAL OF CADR OF THIS IS: ")
(PRINT P)
(AM-BT])
(INSTAN-1I
[LAMBDA (I)
(ERRORSET I])
(INSTAN-1S
[LAMBDA (S)
NIL])
(INSTAN-BASE
[LAMBDA (BASE1 BEX)
(COND
((MATCH BASE1 WITH ('EQ 'A BEX←&))
(PROG1 (SETQ A (ERRORSET BEX))
(SETQ A (COPY (CAR A])
(INSTAN-D
[LAMBDA (DE)
(MAPCONC (CDAR DE)
(QUOTE INSTAN-1D])
(INSTAN-I
[LAMBDA (IN)
(MAPCONC (CDAR IN)
(QUOTE INSTAN-1I])
(INSTAN-PAT
[LAMBDA (PAT1)
(DSUBST (SOME-MEMBER (QUOTE C-ALGS)
(OBJECT (QUOTE EXS)))
(QUOTE &)
PAT1)
(DSUBST (SOME-MEMBER (QUOTE C-ALGS)
(LIST-STRUCTURE (QUOTE EXS)))
(QUOTE --)
PAT1)
(DSUBST (SOME-MEMBER (QUOTE C-ALGS)
(LIST-STRUCTURE (QUOTE EXS)))
(QUOTE $)
PAT1) (* This should be made recursive, on
CAR, it should call itself if LISTP,
else check unpack for ←)
PAT1])
(INSTAN-REC
[LAMBDA (REC1 DPROC)
(AND (MATCH REC1 WITH (=CS-B '(QUOTE C-DEFNS)
DPROC←&))
[OR (MEMB (CAR DPROC)
CONSTRUCTIVE-OPS)
(INTERSECTION CONSTRUCTIVE-OPS (ALL-UP (CAR DPROC)))
(ERSETQ (APPLY* (CAR DPROC)
(QUOTE C-INVERT)
(QUOTE DPROC]
(ERRORSET DPROC])
(INSTAN-S
[LAMBDA (SP)
(MAPCONC (CDAR SP)
(QUOTE INSTAN-1S])
(IS-ONE-OF
[LAMBDA (X XSET)
(AND X XSET (OR (MEMB X XSET)
(IS-ONE-OF (APPLY* X (QUOTE UP))
XSET])
(ISA
[LAMBDA (BNAME BTYPE)
(COND
((EQ BNAME BTYPE))
(BNAME (ISA (APPLY* BNAME (QUOTE UP))
BTYPE])
(KINDS-OF
[LAMBDA (K)
(SUBSET CONCEPTS (FUNCTION (LAMBDA (KC)
(EQ K (APPLY* KC (QUOTE UP])
(LESS-INT
[LAMBDA (A B)
(ILESSP (CAR A)
(CAR B])
(LISTFILES1
[LAMBDA (X)
[COND
((NULL X)
(TERPRI)
(PRIN1 "NO MORE FILES TO LIST JUST NOW ")
(TERPRI))
((LISTP X)
(SETQ X (CAR X]
(TERPRI)
(SETQ X (UNPACK X))
[SETQ X (PACK (LDIFF X (MEMB (QUOTE ;)
X]
(TERPRI)
(PRIN1 (CONCAT "SHOULD I FTP THE FILE " X " OVER TO SAIL? (Y,N)..."))
(COND
((EQ (RATOM)
(QUOTE Y))
(TENEX (CONCAT "FTP
SAIL
LOG AM,DBL MER
SEND " X "≠
" X "
QUIT
"])
(MCON
[NLAMBDA (X)
(SETQ CONCEPTS (SORT (COPY CONCEPTS)))
(FORGOT-ANY)
(MAKEFILE (QUOTE CON2)
(QUOTE RC])
(MORE-GENERAL
[LAMBDA (B1 B2)
(COND
((MEMB B1 (ALL-UP B2))
B2)
((MEMB B2 (ALL-UP B1))
B1)
(T NIL])
(MORE-INT
[LAMBDA (A B)
(IGREATERP (CAR A)
(CAR B])
(MORE-SPECIFIC
[LAMBDA (B1 B2)
(COND
((MEMB B1 (ALL-UP B2))
B1)
((MEMB B2 (ALL-UP B1))
B2)
(T NIL])
(MTOP
[NLAMBDA (X)
[RPLACA TOP2COMS (CONS (QUOTE FNS)
(MERGE X (CDAR TOP2COMS]
(FORGOT-ANY)
(MAKEFILE (QUOTE TOP2)
(QUOTE RC])
(NEW-VERSION
[LAMBDA (NAME VNEW V OLD NEW)
(COND
(V)
((SETQ V VERSION)))
(SETQ OLD (PACK (LIST NAME V)))
[SETQ NEW (PACK (LIST NAME (OR VNEW (ADD1 V]
[NLSETQ (SET (PACK (LIST NEW (QUOTE COMS)))
(EVAL (PACK (LIST OLD (QUOTE COMS]
(PRIN1 (CONCAT "OLD: " OLD ", NEW: " NEW ", V:" V ", ECMS: " (QUOTE REPLACEMENT)))
(ED-ALL (LIST (QUOTE RC) OLD NEW])
(NFN
[LAMBDA NIL NIL])
(NFUN
[LAMBDA (FUNC FIL)
[COND
((NULL FIL)
(SETQ FIL (QUOTE TOP2]
[SETQ FIL (PACK (LIST FIL (QUOTE COMS]
[RPLACA (EVAL FIL)
(CONS (QUOTE FNS)
(MERGE (SORT FUNC)
(CDAR (EVAL FIL]
(PRIN1 " THERE ARE NOW ")
[PRIN1 (LENGTH (CAR (EVAL FIL]
(PRIN1 " FUNCTIONS ON ")
(PRINT FIL])
(ONE-ISA
[LAMBDA (XSET X)
(AND X (CAR (SOME XSET (FUNCTION (LAMBDA (X1)
(ISA X1 X])
(PRUNABLE
[LAMBDA (C)
(NOT (ILESSP INTHRESH (CAR C])
(PRUNE
[LAMBDA (N)
(FRPLACD (SOME CANDS (QUOTE PRUNABLE))
NIL])
(RAND-PRED
[LAMBDA NIL
(ZEROP (RAND 0 1])
(RECTANGLE
[LAMBDA (X1 X2 Y1 Y2)
(COND
((IGREATERP X1 X2)
(SWITCH X1 X2)))
(COND
((IGREATERP Y1 Y2)
(SWITCH Y1 Y2)))
(FOR I1 FROM X1 TO X2 JOIN (FOR I2 FROM Y1 TO Y2 COLLECT (PACK (LIST (QUOTE R)
I1
(QUOTE -)
I2])
(RE-JUDGE
[NLAMBDA (RJ I1)
(COND
((IGREATERP VERBOSITY 8)
(PRIN1 " SUPPOSED TO RE-JUDGE ")
(PRINT RJ))
((AND [SETQ I1 (ERSETQ (APPLY* (CAR RJ)
(QUOTE C-INT)
(EVAL RJ]
(NUMBERP I1)
(IGREATERP I1 EX-THRESH)
(CREATEB RJ])
(SAME-TYPE
[LAMBDA (B1 B2 BTYP)
(OR (AND (EQ B1 BTYP)
(EQ B2 B1)
B1)
(CADR (MEMB BTYP (COM-ANCES B1 B2])
(SATISFIES
[LAMBDA (X CRIT)
(PRIN1 " *** SATISFIES ISNT IN YET: ")
(PRIN1 X)
(PRIN1 ", ")
(PRINT CRIT])
(SELF
[NLAMBDA (X)
(SET X X])
(SFIND
[LAMBDA (L P)
(FASSOC P (CDDR (CADDR L])
(S-MATCH
[NLAMBDA Z NIL])
(START
[LAMBDA NIL
(SETQ DO-THRESH INIT-DOTHRESH)
(SETQ EX-THRESH INIT-EXTHRESH)
(SETQ INTHRESH INIT-INTHRESH)
(SETQ CANDS (COPY INIT-CANDS))
(SETQ PAST (COPY INIT-PAST))
(TERPRI)
(PRIN1 "ENTERING MAIN LOOP NOW.")
(TERPRI)
(TERPRI)
(TLOOP)
(TERPRI)
(PRIN1 "RE-")
(START])
(SWITCH
[NLAMBDA (C1 C2 CTEMP)
(SETQ CTEMP (EVAL C1))
(SET C1 (EVAL C2))
(SET C2 CTEMP])
(SUB-CANDS
[LAMBDA (SL)
[MAPC SL (FUNCTION (LAMBDA (S)
(SOME CANDS (FUNCTION (LAMBDA (C)
(AND (EQUAL (CDR C)
(CDR S))
(RPLACA C (IQUOTIENT (CAR C)
2] (* This is rather an inefficient way to
do this.)
(SORT CANDS])
(TLOOP
[LAMBDA NIL
(PRIN1 "
VERBOSITY LEVEL (0-10) .... ")
(SETQ VERBOSITY (RATOM))
(PROG NIL
L1 (COND
((ILESSP (CAAR CANDS)
DO-THRESH)
(FIND-NEW-CANDS)))
(SETQ CAND (CAR CANDS))
(COND
((IGREATERP VERBOSITY 5)
(PRIN1 " THE CANDIDATE IS ")
(PRINT CAND)))
(SETQ CANDS (CDR CANDS))
[COND
(CANDS)
((SETQ CANDS (COPY CAND-TAIL]
(COND
[(SASSOC CAND PAST)
(COND
((IGREATERP VERBOSITY 3)
(PRIN1 "REPEATER CANDIDATE SKIPPED")
(TERPRI)))
(DE-THRESH)
(COND
((ZEROP DO-THRESH)
(TERPRI)
(HELP "***** AM FATAL COLLAPSE *****" " DO-THRESH IS IDENTICALLY ZERO ")
(TERPRI]
((SETQ CS-INT (CAR CAND))
(SETQ CS-OP (CADR CAND))
(SETQ CS-ACT (CADDR CAND))
(SETQ CS-B (CAR CS-ACT))
(SETQ CS-P (CADR CS-ACT))
(ENSURE-TOP)
(SETQ CVAL (EVAL (CDR CAND)))
(UPDATE)))
(GO L1])
(TRIV-DEFINE
[LAMBDA (F)
(COND
((GETD F))
((PUTD F (SUBST F (QUOTE CS-B)
TRIVB])
(UNFORGETTABLE
[LAMBDA (B P I F ARG1)
(* Each C-SUGGESTS part is ordered: first, when to definitely reject recognition;
next, when to definitely accept it. If it accepts, the being decides on part P, interest level I,
function to do to it F, and then returns (I F (B P args)))
(APPLY* B (QUOTE C-SUGGESTS)
INTHRESH])
(UP-THRESH
[LAMBDA NIL
(SETQ DO-THRESH (IQUOTIENT (IPLUS DO-THRESH (CAR CAND))
2])
(UPDATE
[LAMBDA NIL
(UP-THRESH)
(SETQ INTHRESH (IN-FACTOR DO-THRESH))
(PRUNE INTHRESH)
(SETQ PAST (ATTACH (CONS CAND CVAL)
(DREMOVE (CAR (FLAST PAST))
PAST])
)
[RPAQQ CAND-TAIL ((0 PRINT (QUOTE TAIL-MARK]
[RPAQQ CANDS ((600 PRINT (SET-STRUCTURE EXS))
(22 AND (ANYB-EXS C-SUGGESTS))
(0 PRIN1 (QUOTE TAIL-MARK]
(RPAQQ CONSTRUCTIVE-OPS (INSERTION CONS UNITE APPEND LIST))
(RPAQQ DO-THRESH 1535)
(RPAQQ EX-THRESH 500)
(RPAQQ F-COUNTER 0)
(RPAQQ FROB 400)
(RPAQQ FROB1 300)
(RPAQQ FROB2 600)
(RPAQQ GLOBALVARS
(ALLOP CAND CAND-TAIL CANDS CON2COMS CONCEPTS CONSTRUCTIVE-OPS CS-ACT CS-B CS-INT CS-OP CS-P CVAL DO-THRESH
ECMS EX-THRESH F-COUNTER FACETS FROB FROB1 GATH-PART GEXISTING GLEN GPGM GPNAME GTEMP GTEMP1 GTEMP2
GTEMP3 HCON INIT-CANDS INIT-DOTHRESH INIT-EXTHRESH INIT-INTHRESH INIT-PAST INTHRESH NEW-CANDS PAST PREC
RANDSTATE STICKY-B STICKY-P STRAT SUF1 SUF2 SYS-FORGET-LIST TOP-ACTS TOP2COMS TRIVB USERNAMES VERBOSITY
VERSION))
[RPAQQ INIT-CANDS ((600 PRINT (SET-STRUCTURE EXS))
(22 AND (ANYB-EXS C-SUGGESTS))
(0 PRIN1 (QUOTE TAIL-MARK]
(RPAQQ INIT-PAST ((A B)
(C D)
(E F)
(G H)
(I J)
(K L)
(M N)
(O P)
(Q R)
(S T)))
(RPAQQ INIT-DOTHRESH 1535)
(RPAQQ INIT-EXTHRESH 500)
(RPAQQ INIT-INTHRESH 1000)
(RPAQQ INTHRESH 1000)
(RPAQQ PAST ((A B)
(C D)
(E F)
(G H)
(I J)
(K L)
(M N)
(O P)
(Q R)
(S T)))
(RPAQQ RANDSTATE (10296633954 . 25955773658))
(RPAQQ STICKY-B COMPOSE)
(RPAQQ STICKY-P C-D-R)
(RPAQQ SYS-FORGET-LIST (MAKESYS OBIN FGETP OSIN SYSOUT OSFBSZ PUTDQ))
(RPAQQ TOP-ACTS (ACCESS ADD-CANDS CHECK EVAL EXPR-IN FILLIN GOAL INIT-PART INSTANTIATE PRIN1 PRINT RE-JUDGE RESTRUC
SUB-CANDS TRANSLATE))
[RPAQQ TRIVB (LAMBDA (P A)
(SELECTQ P (MSG (COMMENT TRIVIALITY))
(AND (SETQ GTEMP (GETHASH P PREC))
(CDR (SFIND (EXPR-IN CS-B T)
GTEMP]
(RPAQQ USERNAMES (AVRA BRUCE CORDELL DOUG ED))
(RPAQQ VERBOSITY 0)
(RPAQQ VERSION 1)
(INIT1)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA S-MATCH COMMENT CMATCH CLASS)
(ADDTOVAR NLAML SWITCH SELF RE-JUDGE MTOP MCON CMATCH-AND)
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (1490 22826 (ACCEPT-B 1502 . 2066) (ACCESS 2070 . 2101) (ADD-CANDS 2105 . 2321) (ALL-OF 2325 . 2663)
(ALL-UP 2667 . 2752) (AM-BT 2756 . 3138) (AVG2 3142 . 3209) (CHANGE-B 3213 . 4811) (CHECK 4815 . 5049) (CLASS 5053
. 5106) (CLOSESTUP 5110 . 5346) (CMATCH 5350 . 5378) (CMATCH-AND 5382 . 5427) (COM-ANCES 5431 . 5642) (COMMENT 5646
. 5703) (CREATEB 5707 . 6501) (DE-THRESH 6505 . 6697) (DOTPROD 6701 . 6878) (ED-1F 6882 . 7031) (ED-1P 7035 . 7162)
(ED-1V 7166 . 7328) (ED-ALL 7332 . 7427) (ED-ALLF 7431 . 7535) (ED-ALLP 7539 . 7597) (ED-ALLV 7601 . 7694) (ENSURE
7698 . 8036) (ENSURE-TOP 8040 . 8366) (EXPR-IN 8370 . 8885) (FILLIN 8889 . 9657) (FIND-NEW-CANDS 9661 . 10232) (
FORGOT-ANY 10236 . 10746) (GATH 10750 . 11095) (GEN-FNAME 11099 . 11226) (GEXADD 11230 . 11295) (GEXEC 11299 . 11346)
(GLOB 11350 . 11620) (GPGM-PRIN 11624 . 12325) (GTRANSFER 12329 . 12455) (IN-FACTOR 12459 . 12506) (INIT-C 12510 .
13371) (INIT-PART 13375 . 13623) (INIT1 13627 . 14403) (INIT2 14407 . 14499) (INSTAN-1D 14503 . 15132) (INSTAN-1I
15136 . 15180) (INSTAN-1S 15184 . 15220) (INSTAN-BASE 15224 . 15377) (INSTAN-D 15381 . 15456) (INSTAN-I 15460 . 15535)
(INSTAN-PAT 15539 . 16210) (INSTAN-REC 16214 . 16530) (INSTAN-S 16534 . 16609) (IS-ONE-OF 16613 . 16736) (ISA 16740
. 16864) (KINDS-OF 16868 . 16969) (LESS-INT 16973 . 17035) (LISTFILES1 17039 . 17499) (MCON 17503 . 17634) (MORE-GENERAL
17638 . 17769) (MORE-INT 17773 . 17841) (MORE-SPECIFIC 17845 . 17977) (MTOP 17981 . 18140) (NEW-VERSION 18144 . 18541)
(NFN 18545 . 18570) (NFUN 18574 . 18909) (ONE-ISA 18913 . 19010) (PRUNABLE 19014 . 19074) (PRUNE 19078 . 19156) (
RAND-PRED 19160 . 19209) (RECTANGLE 19213 . 19495) (RE-JUDGE 19499 . 19781) (SAME-TYPE 19785 . 19913) (SATISFIES 19917
. 20043) (SELF 20047 . 20084) (SFIND 20088 . 20143) (S-MATCH 20147 . 20175) (START 20179 . 20518) (SWITCH 20522 .
20628) (SUB-CANDS 20632 . 21006) (TLOOP 21010 . 22030) (TRIV-DEFINE 22034 . 22145) (UNFORGETTABLE 22149 . 22519) (
UP-THRESH 22523 . 22624) (UPDATE 22628 . 22823)))))
STOP